unit Parameter;
(* File: Parameter.pas
   Purpose: Contains the parameter structures and associated routines
      The parameter categories available are:
         1. N last year
         2. N Last age
         3. F year factor
         4. Selection
         5. Natural mortality
         6. Catchability at age
         7. Biomass catchability
         8. SSB catchability
      Each parameter is a cube with dimensions:
         1. Fleet
         2. Year
         3. Age
      A element in this structure consists of value, flag and description.
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
interface

uses index, sysutils, dialogs, strutils, TASACSConfigtypes;

//type
// TParamElm
(*   SinglePtr =^ Single;
   TParamElmPtr =^ TParamElm;
   TParamElm = record
      Value : SinglePtr;
      NotUsed : Integer;
      Cat, Flag, Index, Year, Age : Integer;
      Descr : string50;
   end;*)


// TParamCube
(*   TParamCubePtr =^ TParamCube;
   TParamCube = record
      Elm : array of array of array of TParamElm; //[Fleet, Year, Age]
   end;*)

// Meta parameter
(*   TMetaParam = record
      Text : string;
      DimMask : Integer;
   end;*)

// Parameter flag
const flKeepFixed = 0;
const flEstimate =  1;
const flEqualPrevYear = 2;
const flSpecialCode = 3;
const flEqualPrevAge = -1;

// Parameter dimensions
const cFleet = $01;
const cYear =  $02;
const cAge =   $04;

// Parameter categories
const cNValues = 1;
const cFYearFactor = 2;
const cSelection = 3;
const cNatMort = 4;
const cCBL_Fac_Fleet = 5;
const cCBL_Fac_SSB = 6;
const cCBL_Fac_BM = 7;
const cCBL_Pow_Fleet = 8;
const cCBL_Pow_SSB = 9;
const cCBL_Pow_BM = 10;
const cGamma_Canum = 11;
const cGamma_Fleet = 12;
const cGamma_SSB = 13;
const cGamma_BM = 14;
const cFirstCategory = cNValues;
const cLastCategory = cGamma_BM;


// Setup meta parameters
(*const c_MetaParamSetup : array[cFirstCategory..cLastCategory] of TMetaParam = (
      (Text:'N at last year';        DimMask :                    cAge ),
      (Text:'N at last age';         DimMask :           cYear         ),
      (Text:'F year factor';         DimMask :           cYear         ),
      (Text:'Selection';             DimMask :           cYear or cAge ),
      (Text:'Natural mortality';     DimMask :           cYear or cAge ),
      (Text:'Catchability at age';   DimMask : cFleet or cYear or cAge ),
      (Text:'Biomass catchability';  DimMask : cFleet or cYear         ),
      (Text:'SSB catchability';      DimMask : cFleet or cYear         )
);*)


// Global parameter list with cubes
//var g_ParamCubes : array[cFirstCategory..cLastCategory] of TParamCube;


(*procedure SaveParameters(FileName : string);
procedure LoadParameters(FileName : string);
procedure InitializeParameterStructures;
function GetParamElm(Cat, iFleet, iYear, iAge : Integer) : TParamElmPtr; overload;
function SupportDim(Cat, Dim : Integer) : Boolean;*)


implementation


{type
   TParamFormatItem = record
      Text : string;
      Width : Integer;
   end; // TParamFormatItem


// Parameter format
const pfCategory = 0;
const pfText = 1;
const pfFleet = 2;
const pfYear = 3;
const pfAge = 4;
const pfFlag = 5;
const pfValue = 6;
const pfFirst = pfCategory;
const pfLast = pfValue;


// Parameter format setup
const c_ParFmt : array[pfFirst..pfLast] of
   TParamFormatItem = (
   (Text:'Category'; Width:2),
   (Text:'Text';     Width:50),
   (Text:'Fleet';    Width:4),
   (Text:'Year';     Width:4),
   (Text:'Age';      Width:4),
   (Text:'Flag';     Width:2),
   (Text:'Value';    Width:8)
   );


function SupportDim(Cat, Dim : Integer) : Boolean;
(* Purpose: This function returns true if the given dimension Dim is applicable
            for the given category Cat.
   In:      Cat - category
            Dim - dimension
   Assume:  Cat and Dim are inside its range.
   Promise: True if dimension is applicable, false if not.
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
begin
   Result := (Dim and c_MetaParamSetup[Cat].DimMask) <> 0;
end; // SupportDim


function DimIndexToStr(Cat, Dim, Index : integer) : string;
(* Purpose: This function returns the index description the given
            category Cat and dimension Dim.
   In:      Cat - category
            Dim - dimension
   Assume:  Cat and Dim are inside its ranges.
   Promise: Dimension index description.
   Note:    First fleet, year and age are appended to the index.
            If category dimension isnt applicable, the result is empty
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
var
   DimValue : Integer;
begin
   Result := '';
   if SupportDim(Cat, Dim) then
   begin
      DimValue := Index;
      case Dim of
         cFleet: DimValue := Index + FirstFleet;
         cYear: DimValue := Index + g_IndexInput.FirstYear;
         cAge: DimValue := Index + g_IndexInput.FirstAge;
      end;
      Result := inttostr(DimValue);
   end;
end; // DimIndexToStr


function StrToDimIndex(S : string; Dim : Integer) : Integer;
(* Purpose: This function returns the dimension index from a string
   History: When        Who        What
            23-04-07    Skalevik   Created
*)
const c_DefaultDimIndex = 0;
begin
   Result := c_DefaultDimIndex;
   if S <> '' then
   begin
      Result := round(safestrtofloat(S));
      case Dim of
         cFleet: Result := Result - FirstFleet;
         cYear: Result := Result - g_IndexInput.FirstYear;
         cAge: Result := Result - g_IndexInput.FirstAge;
      end;
   end;
end; // StrToDimIndex


function ParFmtColStart(ParFmt : Integer) : Integer;
(* Purpose: This function returns the start column of a parameter format item
   History: When        Who        What
            23-04-07    Skalevik   Created
*)
var
   iFmt : Integer;
begin
   Result := 1;
   for iFmt := pfFirst to ParFmt - 1 do
      Result := Result + c_ParFmt[iFmt].Width;
end; // ParFmtColStart


procedure SaveParameters(FileName : string);
(* Purpose: This procedure saves the parameters to a parameter file
   History: When        Who        What
            23-04-07    Skalevik   Created
*)
var
   F : TextFile;
   Cat, iFleet, iYear, iAge, NFleets, NYears, NAges,
   iFmt, iStart, Width : Integer;
   FormatStr : string;
   pParamElm : TParamElmPtr;
   pParamCube : TParamCubePtr;
begin
   FormatStr := '';
   for iFmt := pfFirst to pfLast do
      FormatStr := FormatStr + '%' + inttostr(c_ParFmt[iFmt].Width) + 's';
   AssignFile(F,  Filename);
   Rewrite(F);
   try
   writeln(F, '!Parameter file created by Parameter editor ' + datetimetostr(now));
   writeln(F);
   writeln(F, '! From To   # Name');
   for iFmt := pfFirst to pfLast do
   begin
      iStart := ParFmtColStart(iFmt);
      Width := c_ParFmt[iFmt].Width;
      writeln(F, Format('!%3d..%3d %3d %s',
         [iStart, iStart + Width - 1, Width, c_ParFmt[iFmt].Text]));
   end;
   writeln(F);
   writeln(F, '!-------------------------------------------------------------------------');
   for Cat := cFirstCategory to cLastCategory do
   begin
      pParamCube := @g_ParamCubes[Cat];
      NFleets := length(pParamCube^.Elm);
      for iFleet := 0 to NFleets - 1 do
      begin
         NYears := length(pParamCube^.Elm[iFleet]);
         for iYear := 0 to NYears - 1 do
         begin
            NAges := length(pParamCube^.Elm[iFleet, iYear]);
            for iAge := 0 to NAges - 1 do
            begin
               pParamElm := @(pParamCube^.Elm[iFleet,iYear, iAge]);
               writeln(F, Format(FormatStr, [
                  inttostr(Cat),
                  pParamElm^.Descr,
                  DimIndexToStr(Cat, cFleet, iFleet),
                  DimIndexToStr(Cat, cYear, iYear),
                  DimIndexToStr(Cat, cAge, iAge),
                  inttostr(pParamElm^.Flag),
                  floattostr(pParamElm^.Value)]));
            end; // for
         end; // for
      end; // for
   end; // for
   finally
   CloseFile(f);
   end;
end; // SaveParameters


procedure LoadParameters(FileName : string);
(* Purpose: This procedure loads the parameters from parameter file
   Assume:  File exists and is a legal parameter file according to index file
   Promise: Parameters loaded
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
var
   F : TextFile;
   s, sFleet, sYear, sAge : string;
   Cat, iFleet, iYear, iAge : Integer;
   pParamElm : TParamElmPtr;
begin
   AssignFile(F, FileName);
   Reset(F);
   while not eof(F) do
   begin
      readln(F, s);
      if 0 < length(s) then
      begin
         if s[1] = '!' then
            continue;
         Cat := round(safestrtofloat(MidStr(s, ParFmtColStart(pfCategory), c_ParFmt[pfCategory].Width)));
         sFleet := trim(MidStr(s, ParFmtColStart(pfFleet), c_ParFmt[pfFleet].Width));
         sYear := trim(MidStr(s, ParFmtColStart(pfYear), c_ParFmt[pfYear].Width));
         sAge := trim(MidStr(s, ParFmtColStart(pfAge), c_ParFmt[pfAge].Width));
         iFleet := StrToDimIndex(sFleet, cFleet);
         iYear := StrToDimIndex(sYear, cYear);
         iAge := StrToDimIndex(sAge, cAge);
         pParamElm := Parameter.GetParamElm(Cat, iFleet, iYear, iAge);
         if pParamElm <> nil then
         begin
            pParamElm^.Flag := round(safestrtofloat(MidStr(s, ParFmtColStart(pfFlag), c_ParFmt[pfFlag].Width)));
            pParamElm^.Value := safestrtofloat(MidStr(s, ParFmtColStart(pfValue), c_ParFmt[pfValue].Width));
            pParamElm^.Descr := MidStr(s, ParFmtColStart(pfText), c_ParFmt[pfText].Width);
         end;
      end;
   end;
   CloseFile(F);
end; // TfrmParameterEditor.LoadParameters


procedure InitializeParameterStructures;
(* Purpose: This procedure sets up the parameter structure for each
            parameter.
   Assume:  Index input is properly read
   Promise: Allocated and initalized parameters according to index input.
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
var
   Cat, iFleet, iYear, iAge, NFleets, NYears, NAges : integer;
   FleetDim, YearDim, AgeDim : Integer;
   _Descr : string;
   pParamCube : TParamCubePtr;
   pParamElm : TParamElmPtr;
begin
   for Cat := cFirstCategory to cLastCategory do
   begin
      pParamCube := @g_ParamCubes[Cat];
      // Prepare and set dimension
      FleetDim := 1;
      YearDim := 1;
      AgeDim := 1;
      if SupportDim(Cat, cFleet) then
         FleetDim := g_IndexInput.NumFleets;
      if SupportDim(Cat, cYear) then
         YearDim := NumYears;
      if SupportDim(Cat, cAge) then
         AgeDim := NumAges; 
      SetLength(pParamCube^.Elm, FleetDim, YearDim, AgeDim);
      // Initialize content.
      NFleets := length(pParamCube^.Elm);
      for iFleet := 0 to NFleets - 1 do
      begin
         NYears := length(pParamCube^.Elm[iFleet]);
         for iYear := 0 to NYears - 1 do
         begin
            NAges := length(pParamCube^.Elm[iFleet, iYear]);
            for iAge := 0 to NAges - 1 do
            begin
               pParamElm := GetParamElm(Cat, iFleet, iYear, iAge);
               pParamElm^.Flag := 0;
               pParamElm^.Value := 0;
               _Descr := c_MetaParamSetup[Cat].Text;
               if SupportDim(Cat, cFleet) then
                  _Descr := _Descr + ' ' + inttostr(iFleet);
               if SupportDim(Cat, cYear) then
                  _Descr := _Descr + ' ' + inttostr(g_IndexInput.FirstYear + iYear);
               if SupportDim(Cat, cAge) then
                  _Descr := _Descr + ' ' + inttostr(g_IndexInput.FirstAge +iAge);
               pParamElm^.Descr := _Descr;
            end; //
         end; // for
      end; // for
   end; // for
end; // TfrmParameterEditor.InitializeParameterStructures


function GetParamElm(Cat, iFleet, iYear, iAge : Integer) : TParamElmPtr;
(* Purpose: This procedure returns the parameter elm located at given dimension indexes
   In:      Cat: Category
            iFleet: Fleet 0..NumFleets - 1
            iYear:
            iAge:
   Assume:  Dimension indexes are inside its range.
   Promise: Ptr to Parameter elm object.
   History: When        Who        What
            22-04-07    Skalevik   Created
*)
var
   Accepted : Boolean;
   pParamCube : TParamCubePtr;
begin
   Result := nil;
   try
      pParamCube := @g_ParamCubes[Cat];
      Accepted :=
         (Cat in [cFirstCategory..cLastCategory]) and
         (iFleet in [0..(Length(pParamCube^.Elm) - 1)]) and
         (iYear in [0..(Length(pParamCube^.Elm[iFleet]) - 1)]) and
         (iAge in [0..(Length(pParamCube^.Elm[iFleet, iYear]) - 1)]);
         if not Accepted then
            raise Exception.Create(Format('Index is wrong: %d, %d, %d, %d', [Cat, iFleet, iYear, iAge]));
         Result := @pParamCube^.Elm[iFleet, iYear, iAge];
   except on E : Exception do
      begin
         MessageDlg(E.Message, mtError, [mbOK], 0);
      end;
   end;
end; // GetParamElm
}

initialization
//   DecimalSeparator := '.';
end.



